Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2024 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
Chd|====================================================================
Chd|  R2R_EXCHANGE                  source/coupling/rad2rad/r2r_exchange.F
Chd|-- called by -----------
Chd|        RESOL                         source/engine/resol.F         
Chd|-- calls ---------------
Chd|        CHECK_DTNODA_C                source/coupling/rad2rad/rad2rad_c.c
Chd|        GET_IBUF_C                    source/coupling/rad2rad/rad2rad_c.c
Chd|        GET_STIFF_C                   source/coupling/rad2rad/rad2rad_c.c
Chd|        GET_STIFF_SPMD                source/coupling/rad2rad/r2r_exchange.F
Chd|        R2R_BLOCK_C                   source/coupling/rad2rad/rad2rad_c.c
Chd|        R2R_SEM_C                     source/coupling/rad2rad/rad2rad_c.c
Chd|        R2R_UNLOCK_THREADS_C          source/coupling/rad2rad/rad2rad_c.c
Chd|        SEND_DATA_C                   source/coupling/rad2rad/rad2rad_c.c
Chd|        SEND_DATA_NL_C                source/coupling/rad2rad/rad2rad_c.c
Chd|        SEND_DATA_SPMD                source/coupling/rad2rad/r2r_exchange.F
Chd|        SEND_IBUF_C                   source/coupling/rad2rad/rad2rad_c.c
Chd|        SPMD_EXCH_R2R                 source/mpi/r2r/spmd_r2r.F     
Chd|        SPMD_IBCAST                   source/mpi/generic/spmd_ibcast.F
Chd|        GROUPDEF_MOD                  ../common_source/modules/groupdef_mod.F
Chd|        NLOCAL_REG_MOD                ../common_source/modules/nlocal_reg_mod.F
Chd|        RAD2R_MOD                     share/modules/rad2r.F         
Chd|====================================================================
      SUBROUTINE R2R_EXCHANGE(
     1    IEXLNK   ,IGRNOD   ,DX       ,V        ,VR        ,
     2    A        ,AR       ,MS       ,IN       ,STX       ,STR       ,
     3    R2R_ON   ,DD_R2R   ,WEIGHT   ,IAD_ELEM ,FR_ELEM   ,RBY       ,
     4    XDP      ,X        ,DD_R2R_ELEM , SDD_R2R_ELEM, OFF_SPH_R2R  ,
     5    NUMSPH_GLO_R2R,NLOC_DMG)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE RAD2R_MOD
        USE GROUPDEF_MOD
        USE NLOCAL_REG_MOD
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "units_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "com08_c.inc"
#include      "param_c.inc"
#include      "scr05_c.inc"
#include      "task_c.inc"
#include      "rad2r_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER IEXLNK(NR2R,NR2RLNK),
     .          WEIGHT(*), DD_R2R(NSPMD+1,*), IAD_ELEM(2,*), FR_ELEM(*),
     .          DD_R2R_ELEM(*),SDD_R2R_ELEM,OFF_SPH_R2R(*),NUMSPH_GLO_R2R
        INTEGER R2R_ON,NGLOB,NB
C     REAL
        my_real
     .     V(3,*), VR(3,*),  A(3,*)  , AR(3,*), DX(3,*),
     .     MS(*) , IN(*)  ,  STX(*)  , STR(*), RBY(*), X(3,*)
        DOUBLE PRECISION XDP(3,*)
!
        TYPE (GROUP_)  , TARGET, DIMENSION(NGRNOD)  :: IGRNOD
        TYPE(NLOCAL_STR_), TARGET, INTENT(IN)  :: NLOC_DMG
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER I,IEX,IDP,IDG,NNG,OLD_ACTIV,BID,LENR,SIZE,NTOP
C
        INTEGER, DIMENSION(:), POINTER :: GRNOD
        my_real, POINTER, DIMENSION(:) :: MSNL,VNL,FNL
C=======================================================================

C------------------------------------------------------
C------------ Stock force and stifness for exch -------
C------------------------------------------------------

        IF ((R2R_SIU==1).OR.(NSPMD==1)) THEN
          DO IEX = 1, NR2RLNK
            IDG  = IEXLNK(1,IEX)
            IDP  = IEXLNK(2,IEX)
            NNG  = IGRNOD(IDG)%NENTITY
            GRNOD => IGRNOD(IDG)%ENTITY
            IF (NLLNK(IEX)==1) THEN
C----------Non local coupling interface--------------------------
              MSNL  => NLOC_DMG%MASS(1:NLOC_DMG%L_NLOC)
              VNL  => NLOC_DMG%VNL(1:NLOC_DMG%L_NLOC)
              FNL  => NLOC_DMG%FNL(1:NLOC_DMG%L_NLOC,1)
              CALL SEND_DATA_NL_C(IDP,NBDOF_NL(IEX),IADD_NL,FNL,VNL ,
     .                            MSNL,NCYCLE ,IEX)
            ELSEIF (IRESP==1) THEN
C----------simple precision : DX is replaced by XDP--------------
              CALL SEND_DATA_C(
     .          IDP    ,NNG    ,GRNOD  ,A      ,AR     ,
     .          STX    ,STR    ,V      ,VR     ,MS     ,IN     ,
     .          XDP    ,X      ,TYPLNK(IEX),NCYCLE,RBY,TAG_RBY,
     .          ADD_RBY(IEX) ,RBYLNK(IEX),KINLNK(IEX),R2R_KINE,DT1,IEX,
     .          OFF_SPH_R2R  ,NUMSPH_GLO_R2R, NRBY)
            ELSE
C---------double precision---------------------------------------
              CALL SEND_DATA_C(
     .          IDP    ,NNG    ,GRNOD  ,A      ,AR     ,
     .          STX    ,STR    ,V      ,VR     ,MS     ,IN     ,
     .          DX     ,X      ,TYPLNK(IEX),NCYCLE,RBY,TAG_RBY,
     .          ADD_RBY(IEX) ,RBYLNK(IEX),KINLNK(IEX),R2R_KINE,DT1,IEX,
     .          OFF_SPH_R2R  ,NUMSPH_GLO_R2R, NRBY)
            ENDIF
          END DO
        ELSE
          DO IEX = 1, NR2RLNK
            IDG  = IEXLNK(1,IEX)
            IDP  = IEXLNK(2,IEX)
            NNG  = IGRNOD(IDG)%NENTITY
            GRNOD => IGRNOD(IDG)%ENTITY
            IF (IRESP==1) THEN
C----------simple precision : DX is replaced by XDP--------------
              CALL SEND_DATA_SPMD(
     .            IDP,NNG,GRNOD        ,A                    ,AR     ,
     .            STX,STR,V            ,VR                   ,MS     ,
     .            IN ,XDP ,DD_R2R(1,IEX),DD_R2R(NSPMD+1,IEX),WEIGHT,
     .            TYPLNK(IEX),ROTLNK(IEX),RBYLNK(IEX),RBY,IEX)
            ELSE
C----------double precision -------------------------------------
              CALL SEND_DATA_SPMD(
     .            IDP,NNG,GRNOD        ,A                    ,AR     ,
     .            STX,STR,V            ,VR                   ,MS     ,
     .            IN ,DX ,DD_R2R(1,IEX),DD_R2R(NSPMD+1,IEX),WEIGHT,
     .            TYPLNK(IEX),ROTLNK(IEX),RBYLNK(IEX),RBY,IEX)
            ENDIF
          END DO
        ENDIF

C------------------------------------------------------
        IF ((R2R_SIU==1).OR.(ISPMD==0)) CALL R2R_SEM_C()

C------------------------------------------------------
!$OMP PARALLEL
!$OMP MASTER
C------------------------------------------------------
C-------------- Exch flag activation--- ---------------
C------------------------------------------------------

        IF(NSPMD==1.OR.ISPMD==0)THEN
          CALL CHECK_DTNODA_C(I7KGLO)
          OLD_ACTIV = R2R_ACTIV
          R2R_ON    = 0
C----- Check activation flag of current subdomain
          CALL GET_IBUF_C(R2R_ACTIV,1)

          IF (OLD_ACTIV == 1 .AND. R2R_ACTIV == 0) THEN
            WRITE(IOUT,*)' PROCESS DESACTIVATION'
          ENDIF
C------------------------------------------------------
          IF (R2R_ACTIV /= -1) THEN
            DO WHILE (R2R_ACTIV == 0)
              CALL GET_IBUF_C(R2R_ACTIV,1)
            ENDDO
            IF (OLD_ACTIV == 0 .AND. R2R_ACTIV == 1) THEN
              WRITE(IOUT,*)' PROCESS ACTIVATION'
            ENDIF
          END IF
C------------------------------------------------------
          IF (R2R_ACTIV == 1) THEN
            CALL GET_IBUF_C(R2R_ON,1)
C---------infos for th---------------------------------
            IF (R2R_SIU==1) THEN
              CALL SEND_IBUF_C(R2R_TH_FLAG,10)
              IF (IDDOM==0) CALL SEND_IBUF_C(R2R_TH_MAIN,10)
            ENDIF
          ENDIF
        END IF
C------------------------------------------------------
        IF(NSPMD>1)THEN
          CALL SPMD_IBCAST(R2R_ACTIV,R2R_ACTIV,1,1,0,2)
          CALL SPMD_IBCAST(I7KGLO,I7KGLO,1,1,0,2)
          IF (R2R_ACTIV == 1) CALL SPMD_IBCAST(R2R_ON,R2R_ON,1,1,0,2)
        END IF
        IF (R2R_ACTIV == -1) THEN
          TT = TSTOP
C        RETURN
        ENDIF

C------------------------------------------------------
C-------------- Rad2rad activation----- ---------------
C------------------------------------------------------
        IF ((R2R_SIU==1).OR.(ISPMD==0)) THEN
          CALL R2R_SEM_C()
          CALL GET_IBUF_C(BID,1)
          IF (R2R_SIU==1) NTOP = NTHREAD
          IF (R2R_SIU==0) NTOP = NTHREAD*NSPMD
          CALL R2R_UNLOCK_THREADS_C(NTOP)
        ENDIF
C------------------------------------------------------
C------------------------------------------------------
!$OMP END MASTER
        CALL R2R_BLOCK_C()
!$OMP END PARALLEL

C------------------------------------------------------
C------------ Get stifness from shared memory ---------
C------------------------------------------------------

        IF ((R2R_SIU==1).OR.(NSPMD==1)) THEN
          DO IEX = 1, NR2RLNK
            IDG  = IEXLNK(1,IEX)
            IDP  = IEXLNK(2,IEX)
            NNG  = IGRNOD(IDG)%NENTITY
            GRNOD => IGRNOD(IDG)%ENTITY
!
            CALL GET_STIFF_C(
     .         IDP    ,NNG    ,GRNOD,MS     ,IN     ,
     .         STX    ,STR, TYPLNK(IEX),NCYCLE,IEX)
          END DO

C-------New rad2rad HMPP - synchro SPMD- (not needed for NL coupling) -----
          IF ((SDD_R2R_ELEM>0).AND.(NSPMD>1)) THEN
            SIZE =  1 + IRODDL*1
            LENR = IAD_ELEM(1,NSPMD+1)-IAD_ELEM(1,1)
            IF (NCYCLE==0) THEN
              CALL SPMD_EXCH_R2R(
     1        A       ,AR     ,MS,IN ,MS   ,
     2        IAD_ELEM,FR_ELEM,SIZE ,
     3        LENR    ,DD_R2R,DD_R2R_ELEM,1)
            ENDIF
            CALL SPMD_EXCH_R2R(
     1        A       ,AR     ,STX,STR ,MS   ,
     2        IAD_ELEM,FR_ELEM,SIZE ,
     3        LENR    ,DD_R2R,DD_R2R_ELEM,1)
          ENDIF

        ELSE
C--------------------------------------------------------------------
          DO IEX = 1, NR2RLNK
            IDG  = IEXLNK(1,IEX)
            IDP  = IEXLNK(2,IEX)
            NNG  = IGRNOD(IDG)%NENTITY
            GRNOD => IGRNOD(IDG)%ENTITY
            NB = DD_R2R(NSPMD+1,IEX)
            IF (ISPMD==0) THEN
              NGLOB=DD_R2R(NSPMD+1,IEX)+DBNO(IEX)
            ELSE
              NGLOB=NNG
            ENDIF
            CALL GET_STIFF_SPMD(
     .        IDP     ,NNG    ,GRNOD        ,MS   ,IN    ,
     .        STX     ,STR    ,DD_R2R(1,IEX),NGLOB,WEIGHT,
     3        IAD_ELEM,FR_ELEM,NB,IEX,TYPLNK(IEX),ROTLNK(IEX))

          END DO
        ENDIF

C-----------------------------------------------------------------
        RETURN
      END SUBROUTINE R2R_EXCHANGE
C
Chd|====================================================================
Chd|  SEND_DATA_SPMD                source/coupling/rad2rad/r2r_exchange.F
Chd|-- called by -----------
Chd|        R2R_EXCHANGE                  source/coupling/rad2rad/r2r_exchange.F
Chd|-- calls ---------------
Chd|        SEND_DATA_SPMD_C              source/coupling/rad2rad/rad2rad_c.c
Chd|        SPMD_R2R_RBY                  source/mpi/r2r/spmd_r2r.F     
Chd|        SPMD_R2R_RGET                 source/mpi/r2r/spmd_r2r.F     
Chd|        SPMD_R2R_RGET3                source/mpi/r2r/spmd_r2r.F     
Chd|        SPMD_R2R_RGET3_DP             source/mpi/r2r/spmd_r2r.F     
Chd|====================================================================
      SUBROUTINE SEND_DATA_SPMD(
     1   IDP  ,NNG   ,GRNOD  ,A    ,AR    ,
     2   STX  ,STR   ,V      ,VR   ,MS    ,
     3   IN   ,DX    ,DD_R2R ,NGLOB,WEIGHT,
     4   TYP, FLAG_ROT, FLAG_RBY, RBY, IEX)
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER IDP, NNG, NGLOB,i,TYP,
     .          GRNOD(*),FLAG_ROT, FLAG_RBY,
     .          WEIGHT(*), DD_R2R(*), IEX
C     REAL
        my_real
     .          A(3,*), AR(3,*), STX(*), STR(*), V(3,*), VR(3,*),
     .          MS(*), IN(*), RBY(*)
        DOUBLE PRECISION DX(3,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER II,J
        my_real
     .          BUFR1(3,NGLOB), BUFR2(3,NGLOB), BUFR3(NGLOB),
     .          BUFR4(NGLOB), BUFR5(3,NGLOB), BUFR6(3,NGLOB),
     .          BUFR8(NGLOB), BUFR9(NGLOB),BUF_RBY(9,NGLOB)
        DOUBLE PRECISION BUFR7(3,NGLOB)
C
C******************************************************************************C

        IF (TYP/=7) THEN
          CALL SPMD_R2R_RGET3(A,NNG,GRNOD,DD_R2R,WEIGHT,BUFR1)
          CALL SPMD_R2R_RGET3(AR,NNG,GRNOD,DD_R2R,WEIGHT,BUFR2)
          IF (TYP==5) THEN
            CALL SPMD_R2R_RGET3_DP(DX,NNG,GRNOD,DD_R2R,WEIGHT,BUFR7)
            CALL SPMD_R2R_RGET(STX,NNG,GRNOD,DD_R2R,WEIGHT,BUFR3)
            IF(FLAG_ROT /= 0)
     .        CALL SPMD_R2R_RGET(STR,NNG,GRNOD,DD_R2R,WEIGHT,BUFR4)
          ENDIF
          IF ((TYP<=4).OR.(NCYCLE==0)) THEN
            CALL SPMD_R2R_RGET3(V,NNG,GRNOD,DD_R2R,WEIGHT,BUFR5)
            IF(FLAG_ROT /= 0)
     .        CALL SPMD_R2R_RGET3(VR,NNG,GRNOD,DD_R2R,WEIGHT,BUFR6)
          ENDIF
          CALL SPMD_R2R_RGET(MS,NNG,GRNOD,DD_R2R,WEIGHT,BUFR8)
          IF(FLAG_ROT /= 0)
     .      CALL SPMD_R2R_RGET(IN,NNG,GRNOD,DD_R2R,WEIGHT,BUFR9)
          IF (FLAG_RBY==1)
     .      CALL SPMD_R2R_RBY(RBY,NNG,GRNOD,DD_R2R,WEIGHT,IEX,BUF_RBY)
        ENDIF

        IF(ISPMD==0) THEN
          CALL SEND_DATA_SPMD_C(IDP  ,NGLOB,BUFR1,BUFR2,BUFR3,
     2                        BUFR4,BUFR5,BUFR6,BUFR7,BUFR8,
     3                        BUFR9,BUF_RBY,FLAG_RBY,TYP,NCYCLE,IEX)
        ENDIF
C-----------------------------------------------------------------
        RETURN
      END SUBROUTINE SEND_DATA_SPMD
C
Chd|====================================================================
Chd|  GET_STIFF_SPMD                source/coupling/rad2rad/r2r_exchange.F
Chd|-- called by -----------
Chd|        R2R_EXCHANGE                  source/coupling/rad2rad/r2r_exchange.F
Chd|-- calls ---------------
Chd|        GET_STIFF_SPMD_C              source/coupling/rad2rad/rad2rad_c.c
Chd|        SPMD_R2R_RSET                 source/mpi/r2r/spmd_r2r.F     
Chd|====================================================================
      SUBROUTINE GET_STIFF_SPMD(
     1   IDP     ,NNG    ,GRNOD  ,MS   ,IN     ,
     2   STX     ,STR    ,DD_R2R ,NGLOB,WEIGHT ,
     3   IAD_ELEM,FR_ELEM,NB,IEX,TYP,FLAG_ROT)
C----6------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER IDP, NNG, NGLOB, GRNOD(*),IEX,TYP,
     .          WEIGHT(*), DD_R2R(*), IAD_ELEM(2,*), FR_ELEM(*),NB,
     .          FLAG_ROT
        my_real MS(*), IN(*), STX(*), STR(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER LRBUF,i
        my_real
     .          BUFR1(NGLOB), BUFR2(NGLOB), BUFR3(NGLOB), BUFR4(NGLOB)
C
C******************************************************************************C
        IF(ISPMD == 0) THEN
          CALL GET_STIFF_SPMD_C(IDP,NB,BUFR1,BUFR2,BUFR3,BUFR4,
     .                          TYP,NCYCLE,IEX,NGLOB)
        ENDIF

        IF (TYP==5) THEN
          LRBUF = 2*2*(IAD_ELEM(1,NSPMD+1)-IAD_ELEM(1,1))+2*NSPMD

          IF (NCYCLE==0) THEN
            CALL SPMD_R2R_RSET(MS   ,NNG     ,GRNOD,DD_R2R,WEIGHT,
     .                         BUFR1,IAD_ELEM,FR_ELEM,LRBUF,IEX)
          ENDIF
          CALL SPMD_R2R_RSET(STX   ,NNG     ,GRNOD,DD_R2R,WEIGHT,
     .                       BUFR2,IAD_ELEM,FR_ELEM,LRBUF,IEX )
          IF(FLAG_ROT /= 0)THEN
            IF (NCYCLE==0) THEN
              CALL SPMD_R2R_RSET(IN   ,NNG     ,GRNOD,DD_R2R,WEIGHT,
     .                       BUFR3,IAD_ELEM,FR_ELEM,LRBUF,IEX  )
            ENDIF
            CALL SPMD_R2R_RSET(STR   ,NNG     ,GRNOD,DD_R2R,WEIGHT,
     .                       BUFR4,IAD_ELEM,FR_ELEM,LRBUF,IEX  )
          END IF
        END IF

C-----------------------------------------------------------------
        RETURN
      END SUBROUTINE GET_STIFF_SPMD
C
Chd|====================================================================
Chd|  R2R_TAGEL                     source/coupling/rad2rad/r2r_exchange.F
Chd|-- called by -----------
Chd|        TAGOFF3N                      source/interfaces/interf/chkstfn3.F
Chd|-- calls ---------------
Chd|        RAD2R_MOD                     share/modules/rad2r.F         
Chd|====================================================================
      SUBROUTINE R2R_TAGEL(NTAGEL_R2R_SEND,ID_EL,ID_NODE,ITY,OFUR,TAGEL_SIZE)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE RAD2R_MOD
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER NTAGEL_R2R_SEND,ID_EL,ID_NODE,ITY,OFUR,TAGEL_SIZE
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER I,N,TAGEL_SIZE_OLD
        INTEGER, DIMENSION(:),ALLOCATABLE :: TAGEL_TEMP
C=======================================================================

        N = 3*NTAGEL_R2R_SEND
        NTAGEL_R2R_SEND = NTAGEL_R2R_SEND + 1

C----------Reallocation of tagel----------------------------------
        IF (3*NTAGEL_R2R_SEND>TAGEL_SIZE) THEN
C
          IF (TAGEL_SIZE>0) THEN
            ALLOCATE(TAGEL_TEMP(TAGEL_SIZE))
            DO I=1,TAGEL_SIZE
              TAGEL_TEMP(I) = TAGEL_R2R_SEND(I)
            END DO
          ENDIF
C
          TAGEL_SIZE_OLD = TAGEL_SIZE
          TAGEL_SIZE = TAGEL_SIZE + 150
          IF (ALLOCATED(TAGEL_R2R_SEND)) DEALLOCATE(TAGEL_R2R_SEND)
          ALLOCATE(TAGEL_R2R_SEND(TAGEL_SIZE))
          DO I=1,TAGEL_SIZE_OLD
            TAGEL_R2R_SEND(I) = TAGEL_TEMP(I)
          END DO
C
        ENDIF
C------------------------------------------------------------------

        TAGEL_R2R_SEND(N+1) = ID_EL
        TAGEL_R2R_SEND(N+2) = ID_NODE
        TAGEL_R2R_SEND(N+3) = ITY

C-----------------------------------------------------------------
        RETURN
      END SUBROUTINE R2R_TAGEL

Chd|====================================================================
Chd|  R2R_EXCH_ITAG                 source/coupling/rad2rad/r2r_exchange.F
Chd|-- called by -----------
Chd|        TAGOFF3N                      source/interfaces/interf/chkstfn3.F
Chd|-- calls ---------------
Chd|        EXCH_ITAG_C                   source/coupling/rad2rad/rad2rad_c.c
Chd|        GROUPDEF_MOD                  ../common_source/modules/groupdef_mod.F
Chd|====================================================================
      SUBROUTINE R2R_EXCH_ITAG(IEXLNK,IGRNOD,ITAG, FLAG)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE GROUPDEF_MOD
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include "param_c.inc"
#include "com04_c.inc"
#include "rad2r_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER IEXLNK(NR2R,NR2RLNK),ITAG(*),FLAG
        TYPE (GROUP_)  , TARGET, DIMENSION(NGRNOD)  :: IGRNOD
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER I, IEX, IDP, IDG, NNG,NMOD_R2R, OFF
        INTEGER, DIMENSION(:), POINTER :: GRNOD
C=======================================================================

        OFF = 0

        IF (R2R_SIU==1) THEN
C----------Echange of itag ( 0 reception / 1 emission) --------------
          DO IEX = 1, NR2RLNK
            IDP  = IEXLNK(2,IEX)
            IDG  = IEXLNK(1,IEX)
            NNG  = IGRNOD(IDG)%NENTITY
            GRNOD => IGRNOD(IDG)%ENTITY
            CALL EXCH_ITAG_C(IDP,NNG,GRNOD,ITAG,ITAG(NUMNOD+1),IEX,OFF,FLAG)
            OFF = OFF + NNG
          END DO
        ENDIF
C-----------------------------------------------------------------
        RETURN
      END SUBROUTINE R2R_EXCH_ITAG
